home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / MAPIT.for < prev    next >
Text File  |  1991-05-22  |  8KB  |  272 lines
  1.         SUBROUTINE MAPIT(XLOW,XHIGH,YLOW,YHIGH,XLAB,YLAB,TITLE,IAXES)
  2.         IMPLICIT NONE
  3.         INCLUDE DIGLIB$KOM:PLTCOM.PRM
  4.         INCLUDE DIGLIB$KOM:PLTSIZ.PRM
  5.         INCLUDE DIGLIB$KOM:PLTCLP.PRM
  6.         INCLUDE DIGLIB$KOM:PLTPRM.PRM
  7.         INCLUDE DIGLIB$KOM:GCLTYP.PRM
  8. C
  9.     EXTERNAL LEN
  10.     INTEGER LEN
  11.         CHARACTER*1 XLAB(2), YLAB(2), TITLE(2)
  12.         CHARACTER*1 NUMBR(14)
  13.         LOGICAL*1 LOGXX, LOGYY, LOGT, LRMTEX, LSHORT, LRAGGD
  14.     INTEGER*1 IAND
  15.         REAL*4 ZLOG(8),TMINLD,SHORTF,XTMIN,XTMAX,XTICK,YTMIN,YTMAX
  16.         REAL*4 YTICK,VX,VY,TEMP,TENEXP,X,Y,TCKSGN,TICKSP,LN
  17.         INTEGER NUMTK,IXPWR,IYPWR,MXLAB,N,J,ILABSZ
  18. C
  19.         DATA ZLOG /0.3010, 0.4771, 0.6021, 0.6990, 0.7782, 0.8451,
  20.      1   0.9031, 0.9542 /
  21. C       MINIMUM DISTANCE BETWEEN SHORT TICKS (1 MM)
  22.         DATA TMINLD /0.1/
  23. C       SHORT TICKS = TICKLN/SHORTF
  24.         DATA SHORTF /2.0/
  25. C
  26. C       SET LOGX AND LOGY TO FALSE FOR OUR USAGE OF SCALE
  27. C
  28.         LOGX = .FALSE.
  29.         LOGY = .FALSE.
  30. C
  31. C       SEE WHAT TYPE OF AXES ARE DESIRED
  32. C
  33.         LOGXX = IAND(IAXES,1) .NE. 0
  34.         LOGYY = IAND(IAXES,2) .NE. 0
  35.         LRAGGD = IAND(IAXES,256) .NE. 0
  36. C
  37. C       DO THE AXES SCALING
  38. C
  39.         NUMTK = MIN0(10,INT(XVLEN/((ILABSZ()+1.0)*CXSIZE)))
  40.         IF (LOGXX) GO TO 20
  41.         LSHORT = IAND(IAXES,16) .NE. 0
  42.         CALL AXIS(XLOW,XHIGH,NUMTK,LSHORT,LRAGGD,XMIN,XMAX,XTMIN,XTMAX,
  43.      1   XTICK,IXPWR)
  44.         GO TO 40
  45. 20      CALL LAXIS(XLOW,XHIGH,NUMTK,XMIN,XMAX,XTICK)
  46.         XTMIN = XMIN
  47.         XTMAX = XMAX
  48.         IXPWR = 0
  49. 40      NUMTK = MIN0(10,INT(YVLEN/(3.0*CYSIZE)))
  50.         IF (LOGYY) GO TO 60
  51.         LSHORT = IAND(IAXES,32) .NE. 0
  52.         CALL AXIS(YLOW,YHIGH,NUMTK,LSHORT,LRAGGD,YMIN,YMAX,YTMIN,YTMAX,
  53.      1   YTICK,IYPWR)
  54.         GO TO 80
  55. 60      CALL LAXIS(YLOW,YHIGH,NUMTK,YMIN,YMAX,YTICK)
  56.         YTMIN = YMIN
  57.         YTMAX = YMAX
  58.         IYPWR = 0
  59. 80      CONTINUE
  60. C
  61. C       SET UP SCALING FACTORS FOR SCALE
  62. C
  63.         UX0 = XMIN
  64.         UDX = XMAX - XMIN
  65.         UY0 = YMIN
  66.         UDY = YMAX - YMIN
  67. C
  68. C       ********** DRAW Y AXES **********
  69. C
  70.         CALL GSSETC(CYSIZE,0.0)
  71.         LOGT = .FALSE.
  72.         IF (.NOT. LOGYY .OR. YTICK .NE. 1.0) GO TO 90
  73.         CALL SCALE(XMIN,YMIN,VX,TEMP)
  74.         CALL SCALE(XMIN,YMIN+1.0-ZLOG(8),VX,VY)
  75.         IF ((VY-TEMP) .GE. TMINLD) LOGT = .TRUE.
  76. 90      CONTINUE
  77. C
  78. C       DRAW Y AXIS LINE
  79. C
  80.         MXLAB = 3
  81.         TENEXP = 10.0**IYPWR
  82.         X = XMIN
  83. C       TICK SPACING
  84.         TICKSP = AMAX1(0.0,TICKLN)
  85.         IF (IAND(IAXES,64) .NE. 0) YVLEN = YVLEN - TICKSP
  86. C       TICKS TO LEFT FOR LEFT Y AXIS
  87.         TCKSGN = -TICKLN
  88. 100     CONTINUE
  89.         CALL SCALE(X,YMAX,VX,VY)
  90.         CALL GSMOVE(VX,VY)
  91.         CALL SCALE(X,YMIN,VX,VY)
  92.         CALL GSDRAW(VX,VY)
  93. C
  94. C       DRAW AND LABEL Y AXIS TICKS
  95. C
  96.         Y = YTMIN
  97.         N = (YTMAX-YTMIN)/YTICK + 1.1
  98. 110     CONTINUE
  99.         CALL SCALE(X,Y*TENEXP,VX,VY)
  100.         CALL GSMOVE(VX,VY)
  101.         CALL GSDRAW(VX+TCKSGN,VY)
  102.         IF (X .EQ. XMAX) GO TO 185
  103.         IF (IAND(IAXES,1024) .NE. 0) GO TO 183
  104. C
  105. C       PLACE THE APPROPIATE LABEL
  106. C
  107.         IF (LOGYY) GO TO 160
  108.         CALL LINLAB(INT(Y),IYPWR,NUMBR,LRMTEX)
  109.         GO TO 180
  110. 160     CALL LOGLAB(INT(Y),NUMBR)
  111. 180     LN = LEN(NUMBR)
  112.         MXLAB = MAX0(MXLAB,LN)
  113.         CALL GSMOVE(VX-TICKSP-CXSIZE*(LN+0.25),VY-CYSIZE/2.0)
  114.         CALL GSPSTR(NUMBR)
  115. C
  116. C       ADD GRID LINE AT TICK IF DESIRED
  117. C
  118. 183     CONTINUE
  119.         IF (IAND(IAXES,8) .EQ. 0) GO TO 185
  120.         CALL GSLTYP(3)
  121.         CALL GSMOVE(VX,VY)
  122.         CALL SCALE(XMAX,Y*TENEXP,VX,VY)
  123.         CALL GSDRAW(VX,VY)
  124.         CALL GSLTYP(1)
  125. 185     CONTINUE
  126. C
  127. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  128. C
  129.         IF ((.NOT. LOGT) .OR. (Y .EQ. YTMAX)) GO TO 200
  130.         DO 190 J = 1, 8
  131.         CALL SCALE(X,Y+ZLOG(J),VX,VY)
  132.         CALL GSMOVE(VX,VY)
  133. 190     CALL GSDRAW(VX+TCKSGN/SHORTF,VY)
  134. 200     CONTINUE
  135.         Y = Y + YTICK
  136.         N = N-1
  137.         IF (N .GT. 0) GO TO 110
  138.         IF (X .EQ. XMAX) GO TO 300
  139. C
  140. C       IF LINEAR AXIS, PLACE REMOTE EXPONENT IF NEEDED
  141. C
  142.         IF (LOGYY .OR. (.NOT. LRMTEX)) GO TO 260
  143.         IF (IAND(IAXES,1024) .NE. 0) GO TO 260
  144.         CALL SCALE(XMIN,(YTMIN+YTICK/2.0)*TENEXP,VX,VY)
  145.         CALL SCOPY('E'//CHAR(0),NUMBR)
  146.         CALL NUMSTR(IYPWR,NUMBR(2))
  147.         CALL GSMOVE(VX-CXSIZE*(LEN(NUMBR)+0.5),VY-CYSIZE/2.0)
  148.         CALL GSPSTR(NUMBR)
  149. C
  150. C       NOW PLACE Y LABLE
  151. C
  152. 260     CALL SCALE(XMIN,(YMIN+YMAX)/2.0,VX,VY)
  153.         CALL GSMOVE(VX-(MXLAB+0.25)*CXSIZE-TICKSP-CYSIZE,
  154.      1   VY-CXSIZE*LEN(YLAB)/2.0)
  155.         CALL GSSETC(CYSIZE,90.0)
  156.         CALL GSPSTR(YLAB)
  157.         CALL GSSETC(CYSIZE,0.0)
  158.         IF (IAND(IAXES,128) .EQ. 0) GO TO 300
  159.         X = XMAX
  160.         TCKSGN = TICKLN
  161.         GO TO 100
  162. 300     CONTINUE
  163. C
  164. C       ********** DRAW X AXIS **********
  165. C
  166.         LOGT = .FALSE.
  167.         IF (.NOT. LOGXX .OR. XTICK .NE. 1.0) GO TO 310
  168.         CALL SCALE(XMIN,YMIN,TEMP,VY)
  169.         CALL SCALE(XMIN+1.0-ZLOG(8),YMIN,VX,VY)
  170.         IF ((VX-TEMP) .GE. TMINLD) LOGT = .TRUE.
  171. 310     CONTINUE
  172. C
  173. C       DRAW X AXIS LINE
  174. C
  175.         Y = YMIN
  176.         TCKSGN = -TICKLN
  177.         TENEXP = 10.0**IXPWR
  178. C       TICK SPACING
  179.         TICKSP = AMAX1(0.5*CYSIZE,TICKLN)
  180. 320     CONTINUE
  181.         CALL SCALE(XMIN,Y,VX,VY)
  182.         CALL GSMOVE(VX,VY)
  183.         CALL SCALE(XMAX,Y,VX,VY)
  184.         CALL GSDRAW(VX,VY)
  185. C
  186. C       DRAW AND LABEL X AXIS TICKS
  187. C
  188.         X = XTMIN
  189.         N = (XTMAX-XTMIN)/XTICK + 1.1
  190. 400     CONTINUE
  191.         CALL SCALE(X*TENEXP,Y,VX,VY)
  192.         CALL GSMOVE(VX,VY)
  193.         CALL GSDRAW(VX,VY+TCKSGN)
  194.         IF (Y .EQ. YMAX) GO TO 430
  195.         IF (IAND(IAXES,512) .NE. 0) GO TO 423
  196.         IF (LOGXX) GO TO 410
  197.         CALL LINLAB(INT(X),IXPWR,NUMBR,LRMTEX)
  198.         GO TO 420
  199. 410     CALL LOGLAB(INT(X),NUMBR)
  200. 420     CALL GSMOVE(VX-CXSIZE*LEN(NUMBR)/2.0,VY-TICKSP-1.5*CYSIZE)
  201.         CALL GSPSTR(NUMBR)
  202. C
  203. C       ADD GRID LINE AT TICK IF DESIRED
  204. C
  205. 423     CONTINUE
  206.         IF (IAND(IAXES,4) .EQ. 0) GO TO 430
  207.         CALL GSLTYP(3)
  208.         CALL GSMOVE(VX,VY)
  209.         CALL SCALE(X*TENEXP,YMAX,VX,VY)
  210.         CALL GSDRAW(VX,VY)
  211.         CALL GSLTYP(1)
  212. 430     CONTINUE
  213. C
  214. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  215. C
  216.         IF ((.NOT. LOGT) .OR. (X .EQ. XTMAX)) GO TO 490
  217.         DO 450 J = 1, 8
  218.         CALL SCALE(X+ZLOG(J),Y,VX,VY)
  219.         CALL GSMOVE(VX,VY)
  220.         CALL GSDRAW(VX,VY+TCKSGN/SHORTF)
  221. 450     CONTINUE
  222. 490     CONTINUE
  223.         X = X + XTICK
  224.         N = N-1
  225.         IF (N .GT. 0) GO TO 400
  226.         IF (Y .EQ. YMAX) GO TO 590
  227. C
  228. C       NOW PLACE REMOTE EXPONENT IF NEEDED ON LINEAR AXIS
  229. C
  230.         IF (LOGXX .OR. (.NOT. LRMTEX)) GO TO 520
  231.         IF (IAND(IAXES,512) .NE. 0) GO TO 520
  232.         CALL SCALE(XMIN,YMIN,VX,VY)
  233.         CALL SCOPY('E'//CHAR(0),NUMBR)
  234.         CALL NUMSTR(IXPWR,NUMBR(2))
  235.         CALL GSMOVE(VX+3*CXSIZE,VY-TICKSP-2.75*CYSIZE)
  236.         CALL GSPSTR(NUMBR)
  237. C
  238. C       NOW PLACE X AXIS LABLE
  239. C
  240. 520     CALL SCALE((XMIN+XMAX)/2.0,YMIN,VX,VY)
  241.         CALL GSMOVE(VX-CXSIZE*LEN(XLAB)/2.0,VY-TICKSP-4.0*CYSIZE)
  242.         CALL GSPSTR(XLAB)
  243.         IF (IAND(IAXES,64) .EQ. 0) GO TO 590
  244.         Y = YMAX
  245.         TCKSGN = TICKLN
  246.         GO TO 320
  247. 590     CONTINUE
  248. C
  249. C       ********** PLACE TITLE **********
  250. C
  251.         CALL SCALE((XMIN+XMAX)/2.0,YMAX,VX,VY)
  252.         TCKSGN = 0.0
  253.         IF (IAND(IAXES,64) .NE. 0) TCKSGN = TICKSP
  254.         CALL GSMOVE(VX-CXSIZE*LEN(TITLE)/2.0,VY+TCKSGN+CYSIZE)
  255.         CALL GSPSTR(TITLE)
  256. C
  257. C       MAKE SURE "PLTCLP" CONTAINS LIMITS PICKED BY MAPIT.   ONLY MAINTAINED
  258. C       FOR CALLERS INFO.
  259. C
  260.         IF (.NOT. LOGXX) GO TO 610
  261.                 XMIN = 10.0**XMIN
  262.                 XMAX = 10.0**XMAX
  263.                 LOGX = .TRUE.
  264. 610     CONTINUE
  265.         IF (.NOT. LOGYY) GO TO 620
  266.                 YMIN = 10.0**YMIN
  267.                 YMAX = 10.0**YMAX
  268.                 LOGY = .TRUE.
  269. 620     CONTINUE
  270.         RETURN
  271.         END
  272.